home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE10 / FILES / STRM4U.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-29  |  4.2 KB  |  196 lines
  1. unit Strm4u;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TPointList = class(TComponent)
  11.   protected
  12. {$ifdef Windows}
  13.     procedure WriteComponents(Writer: TWriter); override;
  14. {$else}
  15.     procedure GetChildren(Proc: TGetChildProc); override;
  16. {$endif}
  17.   end;
  18.  
  19.   TPointData = class(TComponent)
  20. {$ifdef Windows}
  21.   protected
  22.     function HasParent: Boolean; override;
  23. {$endif}
  24.   public
  25.     X, Y: Word;
  26.     constructor CreateXY(AOwner: TComponent; AX, AY: Word);
  27.     procedure SwapXY;
  28.     procedure DefineProperties(Filer: TFiler); override;
  29.     procedure ReadData(Reader: TReader);
  30.     procedure WriteData(Writer: TWriter);
  31.   end;
  32.  
  33.   TForm1 = class(TForm)
  34.     PaintBox1: TPaintBox;
  35.     Bevel1: TBevel;
  36.     MakeBtn: TButton;
  37.     SaveBtn: TButton;
  38.     LoadBtn: TButton;
  39.     SwapBtn: TButton;
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure PaintBox1Paint(Sender: TObject);
  42.     procedure MakeBtnClick(Sender: TObject);
  43.     procedure SaveBtnClick(Sender: TObject);
  44.     procedure LoadBtnClick(Sender: TObject);
  45.     procedure SwapBtnClick(Sender: TObject);
  46.   private
  47.     PointList: TPointList;
  48.     procedure ClearPoints;
  49.   end;
  50.  
  51. var
  52.   Form1: TForm1;
  53.   Pt: TPointData;
  54.   Loop: Integer;
  55.  
  56. const
  57.   DataFile = 'POINTS4.DAT';
  58.  
  59. implementation
  60.  
  61. {$R *.DFM}
  62.  
  63. {$ifdef Windows}
  64. procedure TPointList.WriteComponents(Writer: TWriter);
  65. var
  66.   Loop: Integer;
  67. begin
  68.   { inherited version does nothing - no need to call it }
  69.   for Loop := 0 to ComponentCount - 1 do
  70.     Writer.WriteComponent(Components[Loop]);
  71. end;
  72. {$else}
  73. procedure TPointList.GetChildren(Proc: TGetChildProc);
  74. var
  75.   Loop: Integer;
  76. begin
  77.   { inherited version does nothing - no need to call it }
  78.   for Loop := 0 to ComponentCount - 1 do
  79.     Proc(Components[Loop]);
  80. end;
  81. {$endif}
  82.  
  83. constructor TPointData.CreateXY(AOwner: TComponent; AX, AY: Word);
  84. begin
  85.   inherited Create(AOwner);
  86.   X := AX;
  87.   Y := AY;
  88. end;
  89.  
  90. {$ifdef Windows}
  91. function TPointData.HasParent: Boolean;
  92. begin
  93.   Result := True;
  94. end;
  95. {$endif}
  96.  
  97. procedure TPointData.SwapXY;
  98. begin
  99.   Tag := X;
  100.   X := Y;
  101.   Y := Tag;
  102. end;
  103.  
  104. procedure TPointData.DefineProperties(Filer: TFiler);
  105. begin
  106.   { Not calling inherited version cos I don't }
  107.   { want any properties bar X and Y stored }
  108.   Filer.DefineProperty('XY', ReadData, WriteData, X or Y <> 0);
  109. end;
  110.  
  111. procedure TPointData.ReadData(Reader: TReader);
  112. begin
  113.   X := Reader.ReadInteger;
  114.   Y := Reader.ReadInteger;
  115. end;
  116.  
  117. procedure TPointData.WriteData(Writer: TWriter);
  118. begin
  119.   Writer.WriteInteger(X);
  120.   Writer.WriteInteger(Y);
  121. end;
  122.  
  123. procedure TForm1.ClearPoints;
  124. begin
  125.   PointList.DestroyComponents
  126. end;
  127.  
  128. procedure TForm1.FormCreate(Sender: TObject);
  129. begin
  130.   PointList := TPointList.Create(Self);
  131. end;
  132.  
  133. procedure TForm1.PaintBox1Paint(Sender: TObject);
  134. begin
  135.   for Loop := 0 to PointList.ComponentCount - 1 do
  136.   begin
  137.     Pt := PointList.Components[Loop] as TPointData;
  138.     if Loop = 0 then
  139.       PaintBox1.Canvas.MoveTo(Pt.X, Pt.Y)
  140.     else
  141.       PaintBox1.Canvas.LineTo(Pt.X, Pt.Y)
  142.   end;
  143. end;
  144.  
  145. procedure TForm1.MakeBtnClick(Sender: TObject);
  146. begin
  147.   ClearPoints;
  148.   for Loop := 1 to {Random(40) + 1}20 do
  149.   begin
  150.     Pt := TPointData.CreateXY(PointList,
  151.             Random(PaintBox1.Width),
  152.             Random(PaintBox1.Height));
  153.     PaintBox1.Invalidate;
  154.   end;
  155. end;
  156.  
  157. procedure TForm1.SaveBtnClick(Sender: TObject);
  158. var
  159.   Stream: TFileStream;
  160. begin
  161.   Stream := TFileStream.Create(DataFile, fmCreate);
  162.   try
  163.     Stream.WriteComponent(PointList);
  164.   finally
  165.     Stream.Free;
  166.   end;
  167.   ClearPoints;
  168.   PaintBox1.Invalidate;
  169. end;
  170.  
  171. procedure TForm1.LoadBtnClick(Sender: TObject);
  172. var
  173.   Stream: TFileStream;
  174. begin
  175.   ClearPoints;
  176.   Stream := TFileStream.Create(DataFile, fmOpenRead or fmShareDenyWrite);
  177.   try
  178.     Stream.ReadComponent(PointList);
  179.   finally
  180.     Stream.Free;
  181.   end;
  182.   PaintBox1.Invalidate;
  183. end;
  184.  
  185. procedure TForm1.SwapBtnClick(Sender: TObject);
  186. begin
  187.   for Loop := 0 to PointList.ComponentCount - 1 do
  188.     (PointList.Components[Loop] as TPointData).SwapXY;
  189.   PaintBox1.Invalidate;
  190. end;
  191.  
  192. initialization
  193.   Randomize;
  194.   RegisterClass(TPointData);
  195. end.
  196.